(defpackage :bacteria-test
  (:use :cl :bacteria :fiveam)
  (:export #:bacteria-suite))

(in-package :bacteria-test)

(def-suite bacteria-suite)

(in-suite bacteria-suite)

(test abc
  (let ((rec-b 0)
        (rec-c 0))
    (with-cells ((a 2)
                 (c (progn
                      (incf rec-c)
                      (* a 3)))
                 (b (progn
                      (incf rec-b)
                      (list a c))))
      (is (equal b '(2 6)))
      (is (= a 2))
      (is (= c 6))
      (is (= 1 rec-b))
      (is (= 1 rec-c))
      (setf a 7)
      (is (= a 7))
      (is (equal b '(7 21)))
      (is (= c 21))
      (is (= 2 rec-b))
      (is (= 2 rec-c))
      (setf a -5)
      (is (= a -5))
      (is (equal b '(-5 -15)))
      (is (= c -15))
      (is (= 3 rec-b))
      (is (= 3 rec-c)))))

(test changing-graph
  (let ((rec-b 0)
        (rec-c 0))
    (with-cells ((a t)
                 (b (progn
                      (incf rec-b)
                      (if a
                          'b-true
                          (list 'a-false c))))
                 (c (progn
                      (incf rec-c)
                      (if a
                          (list 'a-true b)
                          'c-false))))
      (is (equal c '(a-true b-true)))
      (is (eql a t))
      (is (eql b 'b-true))
      (is (= rec-b 1))
      (is (= rec-c 1))

      (setf a nil)
      (is (eql a nil))
      (is (equal b '(a-false c-false)))
      (is (eql c 'c-false))
      (is (= rec-b 2))
      (is (= rec-c 2))

      (setf a t)
      (is (eql a t))
      (is (eql b 'b-true))
      (is (equal c '(a-true b-true)))
      (is (= rec-b 3))
      (is (= rec-c 3)))))

(defun test-chain (&optional (a-in t))
  (let ((a-rec 0) (b-rec 0) (c-rec 0) (y-rec 0))
    (with-cells ((x 10)
                 (a (if a-in
                        3
                        (progn (incf a-rec) (/ x 5))))
                 (b (progn (incf b-rec) (+ a 2)))
                 (c (progn (incf c-rec) (* b 5)))
                 (y (progn (incf y-rec) (+ x c))))
      (is (= x 10))
      (is (= a (if a-in 3 2)))
      (is (= b (+ a 2)))
      (is (= c (* b 5)))
      (is (= y (+ x c)))
      (is (= (if a-in 0 1) a-rec))
      (is (= 1 b-rec))
      (is (= 1 c-rec))
      (is (= 1 y-rec))
      (setf x 25)
      (is (= x 25))
      (is (= a (if a-in 3 5)))
      (is (= b (+ a 2)))
      (is (= c (* b 5)))
      (is (= y (+ x c)))
      (is (= (if a-in 0 2) a-rec))
      (is (= (if a-in 1 2) b-rec))
      (is (= (if a-in 1 2) c-rec))
      (is (= 2 y-rec))
      (when a-in
        (setf a 17)
        (is (= x 25))
        (is (= a 17))
        (is (= b 19))
        (is (= c 95))
        (is (= y 120))
        (is (= 0 a-rec))
        (is (= 2 b-rec))
        (is (= 2 c-rec))
        (is (= 3 y-rec))))))

(test chain
  (test-chain t)
  (test-chain nil))

(test tree
  (let ((b1-rec 0) (b2-rec 0) (b3-rec 0) (c12-rec 0) (c3-rec 0) (d-rec 0))
    (with-cells ((a1 (list :a1))
                 (a2 (list :a2))
                 (a3 (list :a3))
                 (b1 (progn (incf b1-rec)
                            (cons :b1 a1)))
                 (b2 (progn (incf b2-rec)
                            (cons :b2 a2)))
                 (b3 (progn (incf b3-rec)
                            (cons :b3 a3)))
                 (c12 (progn (incf c12-rec)
                             (append (list :c12) b1 b2)))
                 (c3 (progn (incf c3-rec)
                            (cons :c3 b3)))
                 (d (progn (incf d-rec)
                           (append (list :d) c12 c3))))
      (is (equal '(:d :c12 :b1 :a1 :b2 :a2 :c3 :b3 :a3) d))
      (is (= b1-rec 1))
      (is (= b2-rec 1))
      (is (= b3-rec 1))
      (is (= c12-rec 1))
      (is (= c3-rec 1))
      (is (= d-rec 1))

      (setf a1 (list :a1-new))
      (is (equal '(:d :c12 :b1 :a1-new :b2 :a2 :c3 :b3 :a3) d))
      (is (= b1-rec 2))
      (is (= b2-rec 1))
      (is (= b3-rec 1))
      (is (= c12-rec 2))
      (is (= c3-rec 1))
      (is (= d-rec 2))

      (setf a1 (list :a1-newer))
      (is (equal '(:d :c12 :b1 :a1-newer :b2 :a2 :c3 :b3 :a3) d))
      (is (= b1-rec 3))
      (is (= b2-rec 1))
      (is (= b3-rec 1))
      (is (= c12-rec 3))
      (is (= c3-rec 1))
      (is (= d-rec 3))

      (setf a3 (list :a3-new))
      (is (equal '(:d :c12 :b1 :a1-newer :b2 :a2 :c3 :b3 :a3-new) d))
      (is (= b1-rec 3))
      (is (= b2-rec 1))
      (is (= b3-rec 2))
      (is (= c12-rec 3))
      (is (= c3-rec 2))
      (is (= d-rec 4)))))

(test test-with-cells
  (with-cells ((a 3) (y (1+ a)))
    (with-cells ((a nil))
      (with-cells ((b (list a y)))
        (is (every #'bacteria::cell-p
                   (list (the-cell a) (the-cell b) (the-cell y))))
        (is (equal '(nil 4) b))))))

(test events
  (with-cells ((a 1 :activation-function (lambda (c e)
                                           (declare (ignore c))
                                           (when (> e 0) e)))
               (b a :activation-function (lambda (c e)
                                           (declare (ignore c))
                                           (when (> e 1) e))))
    (is (eq t (cell-event (the-cell a))))
    (is (eq t (cell-event (the-cell b))))
    (is (eql b 1))
    (is (eql a b))
    (is (null (cell-event (the-cell a))))
    (is (null (cell-event (the-cell b))))

    (setf (cell-value (the-cell a) :event 0) 2)
    (is (null (cell-event (the-cell a))))
    (is (null (cell-event (the-cell b))))
    (is (eql b 1))
    (is (eql a b))
    (is (null (cell-event (the-cell a))))
    (is (null (cell-event (the-cell b))))

    (setf (cell-value (the-cell a) :event 1) 3)
    (is (eql 1 (cell-event (the-cell a))))
    (is (null (cell-event (the-cell b))))
    (is (eql a 3))
    (is (eql b 1))
    (is (null (cell-event (the-cell a))))
    (is (null (cell-event (the-cell b))))

    (setf (cell-value (the-cell a) :event 2) 4)
    (is (eql 2 (cell-event (the-cell a))))
    (is (eql 2 (cell-event (the-cell b))))
    (is (eql b 4))
    (is (eql a b))
    (is (null (cell-event (the-cell a))))
    (is (null (cell-event (the-cell b))))))

(test observers
  (let* (o (fn (lambda (cell old new) (declare (ignore cell old new)) (setf o t))))
    (with-cells ((a 1))
      (let ((obs (add-observer (the-cell a) fn)))
        (is (not (null o)) "Immediate observer didn't fire")
        (setf o nil)
        (remove-observer (the-cell a) obs))

      (let ((obs (add-observer (the-cell a) fn :fire-immediately? nil)))
        (is (null o) "Non-immediate observer misfired")
        (setf a 2)
        (is (not (null o)) "Non-immediate observer didn't fire")
        (setf o nil)
        (remove-observer (the-cell a) obs))

      (let ((obs (add-observer (the-cell a) (lambda (cell old new)
                                              (when (oddp new)
                                                (funcall fn cell old new))))))
        (is (null o) "Observer fired despite negative trigger outcome (trigger based on computed value)")
        (setf a 3)
        (is (not (null o)) "Observer did not fire despite positive trigger outcome (trigger based on computed value)")
        (setf o nil)
        (remove-observer (the-cell a) obs))

      (let ((obs (add-observer (the-cell a) (lambda (cell old new)
                                              (when (eql (cell-event cell) 3)
                                                (funcall fn cell old new))))))
        (is (null o) "Observer fired despite negative trigger outcome (trigger based on event)")
        (setf a 4)
        (is (null o) "Observer fired despite negative trigger outcome (trigger based on event)")
        (setf (cell-value (the-cell a) :event 3) 5)
        (is (not (null o)) "Observer did not fire despite positive trigger outcome (trigger based on event)")
        (setf o nil)
        (remove-observer (the-cell a) obs)))))

(test recursive-deps
  (with-cells ((c t)
               (x (if c 1 y))
               (y (if c x 2)))
    (is (= 1 y)))

  (with-cells ((a 0))
    (is (= 1 (setf a (1+ a))))
    (is (= 2 (setf a (1+ a)))))

  (with-cells ((a 0) (b a))
    (is (= 1 (setf a (1+ b))))
    (is (= 2 (setf b (1+ a))))))